home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / cal14s6.arc / MDOSIO.PAS < prev   
Pascal/Delphi Source File  |  1988-12-31  |  8KB  |  344 lines
  1.  
  2. (*
  3.  * mdosio - Mini library for interface to DOS v3 file access functions
  4.  *
  5.  * (C) 1987 Samuel H. Smith,  rev. 16-Jan-88
  6.  *
  7.  *)
  8.  
  9. {$i prodef.inc}
  10.  
  11. unit MDosIO;
  12.  
  13. interface
  14.  
  15.    uses Dos;
  16.  
  17.    type
  18.       dos_filename = string[64];
  19.       dos_handle   = word;
  20.  
  21.       long_integer = record
  22.          lsw: word;
  23.          msw: word;
  24.       end;
  25.  
  26.       seek_modes = (seek_start {0},
  27.                     seek_cur   {1},
  28.                     seek_end   {2});
  29.  
  30.       open_modes = (open_read  {h40},     {deny_nothing, allow_read}
  31.                     open_write {h41},     {deny_nothing, allow_write}
  32.                     open_update{h42});    {deny_nothing, allow_read+write}
  33.  
  34.       dos_time_functions = (time_get,
  35.                             time_set);
  36.  
  37.    const
  38.       dos_error    = $FFFF; {file handle after an error}
  39.  
  40.    var
  41.       dos_regs:     registers;
  42.       dos_name:     dos_filename;
  43.  
  44.  
  45.    procedure dos_call;
  46.  
  47.    function dos_open(name:      dos_filename;
  48.                      mode:      open_modes):  dos_handle;
  49.  
  50.    function dos_create(name:    dos_filename): dos_handle;
  51.  
  52.    function dos_read( handle:   dos_handle;
  53.                       var       buffer;
  54.                       bytes:    word): word;
  55.  
  56.    procedure dos_write(handle:  dos_handle;
  57.                        var      buffer;
  58.                        bytes:   word);
  59.  
  60.    function dos_write_failed:   boolean;
  61.  
  62.    procedure dos_lseek(handle:  dos_handle;
  63.                        offset:  longint;
  64.                        method:  seek_modes);
  65.  
  66.    procedure dos_rseek(handle:  dos_handle;
  67.                        recnum:  word;
  68.                        recsiz:  word;
  69.                        method:  seek_modes);
  70.  
  71.    function dos_tell: longint;
  72.  
  73.    procedure dos_find_eof(fd:   dos_handle);
  74.  
  75.    procedure dos_close(handle:  dos_handle);
  76.  
  77.    procedure dos_unlink(name:   dos_filename);
  78.  
  79.    procedure dos_file_times(fd:       dos_handle;
  80.                             func:     dos_time_functions;
  81.                             var time: word;
  82.                             var date: word);
  83.  
  84.    function dos_jdate(time,date: word): longint;
  85.  
  86.    function dos_exists(name: dos_filename): boolean;
  87.  
  88.  
  89. implementation
  90.  
  91. (* -------------------------------------------------------- *)
  92. procedure dos_call;
  93. var
  94.    msg:  string;
  95. begin
  96.    msdos(dos_regs);
  97.  
  98.    if (dos_regs.flags and Fcarry) <> 0 then
  99.    begin
  100.       case dos_regs.ax of
  101.          2:   msg := 'file not found';
  102.          3:   msg := 'dir not found';
  103.          4:   msg := 'too many open files';
  104.          5:   msg := 'access denied';
  105.          else str(dos_regs.ax,msg);
  106.       end;
  107. {$I-}
  108.       writeln('DOS error [',msg,'] on ',dos_name);
  109. {$i+}
  110.       dos_regs.ax := dos_error;
  111.    end;
  112. end;
  113.  
  114.  
  115. (* -------------------------------------------------------- *)
  116. function dos_open(name:    dos_filename;
  117.                   mode:    open_modes):  dos_handle;
  118. var
  119.    try: integer;
  120. const
  121.    retry_count = 3;
  122. begin
  123.    dos_name := name + #0;
  124.  
  125.    for try := 1 to retry_count do
  126.    begin
  127.       dos_regs.ax := $3d40 + ord(mode);
  128.       dos_regs.ds := seg(dos_name);
  129.       dos_regs.dx := ofs(dos_name)+1;
  130.       msdos(dos_regs);
  131.  
  132.       if (dos_regs.flags and Fcarry) = 0 then
  133.       begin
  134.          dos_open := dos_regs.ax;
  135.          exit;
  136.       end;
  137.    end;
  138.  
  139.    dos_open := dos_error;
  140. end;
  141.  
  142.  
  143. (* -------------------------------------------------------- *)
  144. function dos_create(name:    dos_filename): dos_handle;
  145. begin
  146.    dos_regs.ax := $3c00;
  147.    dos_name := name + #0;
  148.    dos_regs.ds := seg(dos_name);
  149.    dos_regs.dx := ofs(dos_name)+1;
  150.    dos_regs.cx := 0;   {attrib}
  151.    dos_call;
  152.    dos_create := dos_regs.ax;
  153. end;
  154.  
  155.  
  156. (* -------------------------------------------------------- *)
  157. function dos_read( handle:  dos_handle;
  158.                    var      buffer;
  159.                    bytes:   word): word;
  160. begin
  161.    dos_regs.ax := $3f00;
  162.    dos_regs.bx := handle;
  163.    dos_regs.cx := bytes;
  164.    dos_regs.ds := seg(buffer);
  165.    dos_regs.dx := ofs(buffer);
  166.    dos_call;
  167.    dos_read := dos_regs.ax;
  168. end;
  169.  
  170.  
  171. (* -------------------------------------------------------- *)
  172. procedure dos_write(handle:  dos_handle;
  173.                     var      buffer;
  174.                     bytes:   word);
  175. begin
  176.    dos_regs.ax := $4000;
  177.    dos_regs.bx := handle;
  178.    dos_regs.cx := bytes;
  179.    dos_regs.ds := seg(buffer);
  180.    dos_regs.dx := ofs(buffer);
  181.    dos_call;
  182.    dos_regs.cx := bytes;
  183. end;
  184.  
  185. function dos_write_failed: boolean;
  186. begin
  187.    dos_write_failed := dos_regs.ax <> dos_regs.cx;
  188. end;
  189.  
  190.  
  191. (* -------------------------------------------------------- *)
  192. procedure dos_lseek(handle:  dos_handle;
  193.                     offset:  longint;
  194.                     method:  seek_modes);
  195. var
  196.    pos:  long_integer absolute offset;
  197.  
  198. begin
  199.    dos_regs.ax := $4200 + ord(method);
  200.    dos_regs.bx := handle;
  201.    dos_regs.cx := pos.msw;
  202.    dos_regs.dx := pos.lsw;
  203.    dos_call;
  204. end;
  205.  
  206.  
  207. (* -------------------------------------------------------- *)
  208. procedure dos_rseek(handle:  dos_handle;
  209.                     recnum:  word;
  210.                     recsiz:  word;
  211.                     method:  seek_modes);
  212. var
  213.    offset: longint;
  214.    pos:    long_integer absolute offset;
  215.  
  216. begin
  217.    offset := longint(recnum) * longint(recsiz);
  218.    dos_regs.ax := $4200 + ord(method);
  219.    dos_regs.bx := handle;
  220.    dos_regs.cx := pos.msw;
  221.    dos_regs.dx := pos.lsw;
  222.    dos_call;
  223. end;
  224.  
  225.  
  226. (* -------------------------------------------------------- *)
  227. function dos_tell: longint;
  228.   {call immediately after dos_lseek or dos_rseek}
  229. var
  230.    pos:  long_integer;
  231.    li:   longint absolute pos;
  232. begin
  233.    pos.lsw := dos_regs.ax;
  234.    pos.msw := dos_regs.dx;
  235.    dos_tell := li;
  236. end;
  237.  
  238.  
  239. (* -------------------------------------------------------- *)
  240. procedure dos_find_eof(fd: dos_handle);
  241.    {find end of file, skip backward over ^Z eof markers}
  242. var
  243.    b: char;
  244.    n: word;
  245.    i: word;
  246.    p: longint;
  247.    temp: array[1..128] of char;
  248.  
  249. begin
  250.    dos_lseek(fd,0,seek_end);
  251.    p := dos_tell-1;
  252.    if p < 0 then
  253.       exit;
  254.  
  255.    p := p and $FFFF80;   {round to last 'sector'}
  256.    {search forward for the eof marker}
  257.    dos_lseek(fd,p,seek_start);
  258.    n := dos_read(fd,temp,sizeof(temp));
  259.    i := 1;
  260.  
  261.    while (i <= n) and (temp[i] <> ^Z) do
  262.    begin
  263.       inc(i);
  264.       inc(p);
  265.    end;
  266.  
  267.    {backup to overwrite the eof marker}
  268.    dos_lseek(fd,p,seek_start);
  269. end;
  270.  
  271.  
  272. (* -------------------------------------------------------- *)
  273. procedure dos_close(handle:  dos_handle);
  274. begin
  275.    dos_regs.ax := $3e00;
  276.    dos_regs.bx := handle;
  277.    msdos(dos_regs);  {dos_call;}
  278. end;
  279.  
  280.  
  281. (* -------------------------------------------------------- *)
  282. procedure dos_unlink(name:    dos_filename);
  283.    {delete a file, no error message if file doesn't exist}
  284. begin
  285.    dos_regs.ax := $4100;
  286.    dos_name := name + #0;
  287.    dos_regs.ds := seg(dos_name);
  288.    dos_regs.dx := ofs(dos_name)+1;
  289.    msdos(dos_regs);
  290. {dos_call;}
  291. end;
  292.  
  293.  
  294. (* -------------------------------------------------------- *)
  295. procedure dos_file_times(fd:       dos_handle;
  296.                          func:     dos_time_functions;
  297.                          var time: word;
  298.                          var date: word);
  299. begin
  300.    dos_regs.ax := $5700 + ord(func);
  301.    dos_regs.bx := fd;
  302.    dos_regs.cx := time;
  303.    dos_regs.dx := date;
  304.    dos_call;
  305.    time := dos_regs.cx;
  306.    date := dos_regs.dx;
  307. end;
  308.  
  309.  
  310. (* -------------------------------------------------------- *)
  311. function dos_jdate(time,date: word): longint;
  312. begin
  313.  
  314. (***
  315.      write(' d=',date:5,' t=',time:5,' ');
  316.      write('8',   (date shr 9) and 127:1); {year}
  317.      write('/',   (date shr 5) and  15:2); {month}
  318.      write('/',   (date      ) and  31:2); {day}
  319.      write(' ',   (time shr 11) and 31:2); {hour}
  320.      write(':',   (time shr  5) and 63:2); {minute}
  321.      write(':',   (time shl  1) and 63:2); {second}
  322.      writeln(' j=', (longint(date) shl 16) + longint(time));
  323.  ***)
  324.  
  325.    dos_jdate := (longint(date) shl 16) + longint(time);
  326. end;
  327.  
  328.  
  329. (* -------------------------------------------------------- *)
  330. function dos_exists(name: dos_filename): boolean;
  331. var
  332.    DirInfo:     SearchRec;
  333.  
  334. begin
  335.    dos_name := name;
  336.    FindFirst(name,$21,DirInfo);
  337.    if (DosError <> 0) then
  338.       dos_exists := false
  339.    else
  340.       dos_exists := true;
  341. end;
  342.  
  343. end.
  344.